home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / pkgs.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  19.2 KB  |  702 lines
  1. package pkgs;
  2.  
  3.  
  4.  
  5.  
  6.  
  7. use common qw(:common :file :functional);
  8. use install_any;
  9. use log;
  10. use pkgs;
  11. use fs;
  12. use lang;
  13. use c;
  14.  
  15. my @skip_list = qw(
  16. XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach64 XFree86-Mach8 XFree86-Mono
  17. XFree86-P9000 XFree86-S3 XFree86-S3V XFree86-SVGA XFree86-W32 XFree86-I128
  18. XFree86-Sun XFree86-SunMono XFree86-Sun24 XFree86-3DLabs
  19. MySQL MySQL_GPL mod_php3 midgard postfix metroess metrotmpl
  20. kernel-linus kernel-secure kernel-fb kernel-BOOT
  21. hackkernel hackkernel-BOOT hackkernel-fb hackkernel-headers
  22. hackkernel-pcmcia-cs hackkernel-smp hackkernel-smp-fb 
  23. autoirpm autoirpm-icons numlock 
  24. );
  25.  
  26. my %by_lang = (
  27.   ar    => [ 'acon' ],
  28.   cs    => [ 'XFree86-ISO8859-2' ],
  29.   hr    => [ 'XFree86-ISO8859-2' ],
  30.   hu    => [ 'XFree86-ISO8859-2' ],
  31.   ja    => [ 'rxvt-CLE', 'fonts-ttf-japanese', 'kterm' ],
  32.   ko    => [ 'rxvt-CLE', 'fonts-ttf-korean' ],
  33.   pl    => [ 'XFree86-ISO8859-2' ],
  34.   ro    => [ 'XFree86-ISO8859-2' ],
  35.   ru    => [ 'XFree86-cyrillic-fonts' ],
  36.   sk    => [ 'XFree86-ISO8859-2' ],
  37.   sl    => [ 'XFree86-ISO8859-2' ],
  38.   sr    => [ 'XFree86-ISO8859-2' ],
  39.   tr    => [ 'XFree86-ISO8859-9' ],
  40.   zh_CN => [ 'rxvt-CLE', 'fonts-ttf-gb2312' ],
  41.   'zh_TW.Big5' => [ 'rxvt-CLE', 'fonts-ttf-big5' ],
  42. );
  43.  
  44. my @preferred = qw(perl-GTK postfix ghostscript-X);
  45.  
  46. my $A = 20471;
  47. my $B = 16258;
  48. sub correctSize { ($A - $_[0]) * $_[0] / $B } 
  49. sub invCorrectSize { $A / 2 - sqrt(max(0, sqr($A) - 4 * $B * $_[0])) / 2 }
  50.  
  51. sub selectedSize {
  52.     my ($packages) = @_;
  53.     int (sum map { $_->{size} } grep { $_->{selected} } values %$packages) / sqr(1024);
  54. }
  55. sub correctedSelectedSize { correctSize(selectedSize($_[0])) }
  56.  
  57. sub Package {
  58.     my ($packages, $name) = @_;
  59.     $packages->{$name} or log::l("unknown package `$name'") && undef;
  60. }
  61.  
  62. sub allpackages {
  63.     my ($packages) = @_;
  64.     my %skip_list; @skip_list{@skip_list} = ();
  65.     grep { !exists $skip_list{$_->{name}} } values %$packages;
  66. }
  67.  
  68. sub select($$;$) {
  69.     my ($packages, $p, $base) = @_;
  70.     my %preferred; @preferred{@preferred} = ();
  71.     my ($n, $v);
  72. #   print "## $p->{name}\n";
  73.     unless ($p->{installed}) { 
  74.     $p->{base} ||= $base;
  75.     $p->{selected} = -1; 
  76.     my %l; @l{@{$p->{deps} || die "missing deps file"}} = ();
  77.     while (do { my %l = %l; while (($n, $v) = each %l) { last if $v != 1; } $n }) {
  78.         $l{$n} = 1;
  79.         my $i = $packages->{$n};
  80.         if (!$i && $n =~ /\|/) {
  81.         foreach (split '\|', $n) {
  82.             my $p = Package($packages, $_);
  83.             $i ||= $p;
  84.             $p && $p->{selected} and $i = $p, last;
  85.             $p && exists $preferred{$_} and $i = $p;
  86.         }
  87.         }
  88.         $i->{base} ||= $base;
  89.         $i->{deps} or log::l("missing deps for $n");
  90.         unless ($i->{installed}) {
  91.         unless ($i->{selected}) {
  92. #            print ">> $i->{name}\n";
  93. #            /gnome-games/ and print ">>> $i->{name}\n" foreach @{$i->{deps} || []};
  94.             $l{$_} ||= 0 foreach @{$i->{deps} || []};
  95.         }
  96.         $i->{selected}++ unless $i->{selected} == -1;
  97.         }
  98.     }
  99.     }
  100.     1;
  101. }
  102. sub unselect($$) {
  103.     my ($packages, $p) = @_;
  104.     $p->{base} and return;
  105.     my $set = set_new($p->{name});
  106.     my $l = $set->{list};
  107.  
  108.     
  109.     foreach my $q (@$l) {
  110.     my $i = Package($packages, $q);
  111.     $i->{selected} && !$i->{base} or next;
  112.     $i->{selected} = 1; 
  113.     set_add($set, @{$i->{provides} || []});
  114.     }
  115.     while (@$l) {
  116.     my $n = shift @$l;
  117.     my $i = Package($packages, $n);
  118.  
  119.     $i->{selected} <= 0 || $i->{base} and next;
  120.     if (--$i->{selected} == 0) {
  121.         push @$l, @{$i->{deps} || []};
  122.     }
  123.     }
  124.     1;
  125. }
  126. sub toggle($$) {
  127.     my ($packages, $p) = @_;
  128.     $p->{selected} ? unselect($packages, $p) : &select($packages, $p);
  129. }
  130. sub set($$$) {
  131.     my ($packages, $p, $val) = @_;
  132.     $val ? &select($packages, $p) : unselect($packages, $p);
  133. }
  134.  
  135. sub unselect_all($) {
  136.     my ($packages) = @_;
  137.     $_->{selected} = $_->{base} foreach values %$packages;
  138. }
  139.  
  140. sub size_selected {
  141.     my ($packages) = @_;
  142.     my $nb = 0; foreach (values %$packages) {
  143.     $nb += $_->{size} if $_->{selected};
  144.     }
  145.     $nb;
  146. }
  147.  
  148. sub skip_set {
  149.     my ($packages, @l) = @_;
  150.     $_->{skip} = 1 foreach @l, grep { $_ } map { Package($packages, $_) } map { @{$_->{provides} || []} } @l;
  151. }
  152.  
  153. sub psUsingDirectory(;$) {
  154.     my $dirname = $_[0] || "/tmp/rhimage/Mandrake/RPMS";
  155.     my %packages;
  156.  
  157.     log::l("scanning $dirname for packages");
  158.     foreach (all("$dirname")) {
  159.     my ($name, $version, $release) = /(.*)-([^-]+)-([^-]+)\.[^.]+\.rpm/ or log::l("skipping $_"), next;
  160.  
  161.     $packages{$name} = {
  162.             name => $name, version => $version, release => $release,
  163.         file => $_, selected => 0, deps => [],
  164.         };
  165.     }
  166.     \%packages;
  167. }
  168.  
  169. sub psUsingHdlist() {
  170.     my $f = install_any::getFile('hdlist') or die "no hdlist found";
  171.     my %packages;
  172.  
  173.  
  174.  
  175.  
  176.  
  177.     while (my $header = c::headerRead(fileno $f, 1)) {
  178.  
  179.     my $name = c::headerGetEntry($header, 'name');
  180.  
  181.     $packages{$name} = {
  182.              name => $name, header => $header, selected => 0, deps => [],
  183.          version   => c::headerGetEntry($header, 'version'),
  184.          release   => c::headerGetEntry($header, 'release'),
  185.          size      => c::headerGetEntry($header, 'size'),
  186.         };
  187.     }
  188.     log::l("psUsingHdlist read " . scalar keys(%packages) . " headers");
  189.  
  190.     \%packages;
  191. }
  192.  
  193. sub chop_version($) {
  194.     first($_[0] =~ /(.*)-[^-]+-[^-]+/) || $_[0];
  195. }
  196.  
  197. sub getDeps($) {
  198.     my ($packages) = @_;
  199.  
  200.     my $f = install_any::getFile("depslist") or die "can't find dependencies list";
  201.     foreach (<$f>) {
  202.     my ($name, $size, @deps) = split;
  203.     ($name, @deps) = map { join '|', map { chop_version($_) } split '\|' } ($name, @deps);
  204.     $packages->{$name} or next;
  205.     $packages->{$name}{size} = $size;
  206.     $packages->{$name}{deps} = \@deps;
  207.     map { push @{$packages->{$_}{provides}}, $name if $packages->{$_} } @deps;
  208.     }
  209. }
  210.  
  211. sub category2packages($) {
  212.     my ($p) = @_;
  213.     $p->{packages} || [ map { @{ category2packages($_) } } values %{$p->{childs}} ];
  214. }
  215.  
  216. sub readCompss($) {
  217.     my ($packages) = @_;
  218.     my ($compss, $compss_, $ps) = { childs => {} };
  219.  
  220.     my $f = install_any::getFile("compss") or die "can't find compss";
  221.     foreach (<$f>) {
  222.     /^\s*$/ || /^#/ and next;
  223.     s/#.*//;
  224.  
  225.     if (/^(\S+)/) {
  226.         my $p = $compss;
  227.         my @l = split ':', $1;
  228.  
  229.         foreach (@l) {
  230.         $p->{childs}{$_} ||= { childs => {} };
  231.         $p = $p->{childs}{$_};
  232.         }
  233.         $ps = $p->{packages} ||= [];
  234.         $compss_->{$1} = $p;
  235.     } else {
  236.         /(\S+)/ or log::l("bad line in compss: $_"), next;
  237.         push @$ps, $packages->{$1} || do { log::l("unknown package $1 (in compss)"); next };
  238.     }
  239.     }
  240.     ($compss, $compss_);
  241. }
  242.  
  243. sub readCompssList($$$) {
  244.     my ($packages, $compss_) = @_;
  245.     my $f = install_any::getFile("compssList") or die "can't find compssList";
  246.     local $_ = <$f>;
  247.     my $level = [ split ];
  248.  
  249.     my $nb_values = 3;
  250.     my $e;
  251.     foreach (<$f>) {
  252.     /^\s*$/ || /^#/ and next;
  253.  
  254.     /^packages\s*$/ and do { $e = $packages; next };
  255.     /^categories\s*$/ and do { $e = $compss_; next };
  256.  
  257.     my ($name, @values) = split;
  258.  
  259.     $e or log::l("neither packages nor categories");
  260.     my $p = $e->{$name} or log::l("unknown entry $name (in compssList)"), next;
  261.     $p->{values} = \@values;
  262.     }
  263.  
  264.     my %done;
  265.     my $locales = "locales-" . substr($ENV{LANG}, 0, 2);
  266.     if (my $p = $packages->{$locales}) {
  267.     foreach ($locales, @{$p->{provides} || []}, @{$by_lang{$ENV{LANG}} || []}) {
  268.         next if $done{$_}; $done{$_} = 1;
  269.         my $p = $packages->{$_} or next;
  270.         $p->{values} = [ map { $_ + 90 } @{$p->{values} || [ (0) x $nb_values ]} ];
  271.     }
  272.     }
  273.     $level;
  274. }
  275.  
  276. sub readCompssUsers {
  277.     my ($packages, $compss) = @_;
  278.     my (%compssUsers, @sorted, $l);
  279.  
  280.     my $f = install_any::getFile("compssUsers") or die "can't find compssUsers";
  281.     foreach (<$f>) {
  282.     /^\s*$/ || /^#/ and next;
  283.     s/#.*//;
  284.  
  285.     if (/^(\S.*)/) {
  286.         push @sorted, $1;
  287.         $compssUsers{$1} = $l = [];
  288.     } elsif (/\s+\+(\S+)/) {
  289.         push @$l, $packages->{$1} || do { log::l("unknown package $1 (in compssUsers)"); next };
  290.     } elsif (/\s+(\S+)/) {
  291.         my $p = $compss;
  292.         $p &&= $p->{childs}{$_} foreach split ':', $1;
  293.         $p or log::l("unknown category $1 (in compssUsers)"), next;
  294.         push @$l, @{ category2packages($p) };
  295.     }
  296.     }
  297.     \%compssUsers, \@sorted;
  298. }
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307. sub setSelectedFromCompssList {
  308.     my ($compssListLevels, $packages, $min_level, $max_size, $install_class) = @_;
  309.     my ($ind);
  310.  
  311.     my @packages = allpackages($packages);
  312.     my @places = do {
  313.     map_index { $ind = $::i if $_ eq $install_class } @$compssListLevels;
  314.     defined $ind or log::l("unknown install class $install_class in compssList"), return;
  315.  
  316.     
  317.     my @values = map { $_->{values}[$ind] + ($_->{unskip} && $_->{name} !~ /^k/ ? 10 : 0) } @packages;
  318.     sort { $values[$b] <=> $values[$a] } 0 .. $#packages;
  319.     };
  320.     foreach (@places) {
  321.     my $p = $packages[$_];
  322.     next if $p->{skip};
  323.     last if $p->{values}[$ind] < $min_level;
  324.  
  325.     &select($packages, $p);
  326.  
  327.     my $nb = 0; foreach (@packages) {
  328.         $nb += $_->{size} if $_->{selected};
  329.     }
  330.     if ($max_size && $nb > $max_size) {
  331.         unselect($packages, $p);
  332.         $min_level = $p->{values}[$ind];
  333.         log::l("setSelectedFromCompssList: up to indice $min_level (reached size $max_size)");
  334.         last;
  335.     }
  336.     }
  337.     $ind, $min_level;
  338. }
  339.  
  340. sub init_db {
  341.     my ($prefix, $isUpgrade) = @_;
  342.  
  343.     my $f = "$prefix/root/install.log";
  344.     open(LOG, "> $f") ? log::l("opened $f") : log::l("Failed to open $f. No install log will be kept.");
  345.     *LOG or *LOG = log::F() or *LOG = *STDERR;
  346.     CORE::select((CORE::select(LOG), $| = 1)[0]);
  347.     c::rpmErrorSetCallback(fileno LOG);
  348.  
  349.  
  350.     log::l("reading /usr/lib/rpm/rpmrc");
  351.     c::rpmReadConfigFiles() or die "can't read rpm config files";
  352.     log::l("\tdone");
  353.  
  354.     if ($isUpgrade) {
  355.     c::rpmdbRebuild($prefix) or die "rebuilding of rpm database failed: ", c::rpmErrorString();
  356.     }
  357.  
  358.     c::rpmdbInit($prefix, 0644) or die "creation of rpm database failed: ", c::rpmErrorString();
  359.  
  360. }
  361.  
  362. sub done_db {
  363.     log::l("closing install.log file");
  364.     close LOG;
  365. }
  366.  
  367. sub getHeader($) {
  368.     my ($p) = @_;
  369.  
  370.     unless ($p->{header}) {
  371.     my $f = install_any::getFile($p->{file}) or die "error opening package $p->{name} (file $p->{file})";
  372.     $p->{header} = c::rpmReadPackageHeader(fileno $f) or die "bad package $p->{name}";
  373.     }
  374.     $p->{header};
  375. }
  376.  
  377. sub versionCompare($$) {
  378.     my ($a, $b) = @_;
  379.     local $_;
  380.  
  381.     while ($a && $b) {
  382.     my ($sb, $sa) =  map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D+)// } ($b, $a);
  383.     $_ = length($sa) cmp length($sb) || $sa cmp $sb and return $_;
  384.     }
  385. }
  386.  
  387. sub selectPackagesToUpgrade($$$;$$) {
  388.     my ($packages, $prefix, $base, $toRemove, $toSave) = @_;
  389.  
  390.     log::l("reading /usr/lib/rpm/rpmrc");
  391.     c::rpmReadConfigFiles() or die "can't read rpm config files";
  392.     log::l("\tdone");
  393.  
  394.     my $db = c::rpmdbOpenForTraversal($prefix) or die "unable to open $prefix/var/lib/rpm/packages.rpm";
  395.     log::l("opened rpm database for examining existing packages");
  396.  
  397.     local $_; 
  398.     my %installedFilesForUpgrade; 
  399.  
  400.     
  401.     my %upgradeNeedRemove = (
  402.                  'compat-glibc' => 1,
  403.                  'compat-libs' => 1,
  404.                 );
  405.  
  406.     
  407.     my %toRemove; map { $toRemove{$_} = 1 } @{$toRemove || []};
  408.  
  409.     
  410.     
  411.     
  412.     c::rpmdbTraverse($db, sub {
  413.              my ($header) = @_;
  414.              my $p = $packages->{c::headerGetEntry($header, 'name')};
  415.              my $otherPackage = (c::headerGetEntry($header, 'release') !~ /mdk\w*$/ &&
  416.                          (c::headerGetEntry($header, 'name'). '-' .
  417.                           c::headerGetEntry($header, 'version'). '-' .
  418.                           c::headerGetEntry($header, 'release')));
  419.              if ($p) {
  420.                  eval { getHeader($p) }; $@ && log::l("cannot get the header for package $p->{name}");
  421.                  my $version_cmp = versionCompare(c::headerGetEntry($header, 'version'), $p->{version});
  422.                  my $version_rel_test = $p->{header} ? c::rpmVersionCompare($header, $p->{header}) >= 0 :
  423.                    ($version_cmp > 0 ||
  424.                 $version_cmp == 0 &&
  425.                 versionCompare(c::headerGetEntry($header, 'release'), $p->{release}) >= 0);
  426.                  if ($version_rel_test) {
  427.                  if ($otherPackage && $version_cmp <= 0) {
  428.                      log::l("removing $otherPackage since it will not be updated otherwise");
  429.                      $toRemove{$otherPackage} = 1; 
  430.                  } else {
  431.                      $p->{installed} = 1;
  432.                  }
  433.                  } elsif ($upgradeNeedRemove{$p->{name}}) {
  434.                  my $otherPackage = (c::headerGetEntry($header, 'name'). '-' .
  435.                              c::headerGetEntry($header, 'version'). '-' .
  436.                              c::headerGetEntry($header, 'release'));
  437.                  log::l("removing $otherPackage since it will not upgrade correctly!");
  438.                  $toRemove{$otherPackage} = 1; 
  439.                  }
  440.              } else {
  441.                  my @files = c::headerGetEntry($header, 'filenames');
  442.                  @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| &&
  443.                                    ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = ();
  444.              }
  445.              });
  446.  
  447.     
  448.     foreach (values %$packages) {
  449.     my $p = $_;
  450.     my $skipThis = 0;
  451.     my $count = c::rpmdbNameTraverse($db, $p->{name}, sub {
  452.                          my ($header) = @_;
  453.                          $skipThis ||= $p->{installed};
  454.                      });
  455.  
  456.     
  457.     $skipThis ||= ($count == 0);
  458.  
  459.     
  460.     unless ($skipThis) {
  461.         my $cumulSize;
  462.  
  463.         pkgs::select($packages, $p) unless $p->{selected};
  464.  
  465.         
  466.         
  467.         
  468.         c::rpmdbNameTraverse($db, $p->{name}, sub {
  469.                      my ($header) = @_;
  470.                      my $otherPackage = (c::headerGetEntry($header, 'release') !~ /mdk\w*$/ &&
  471.                              (c::headerGetEntry($header, 'name'). '-' .
  472.                               c::headerGetEntry($header, 'version'). '-' .
  473.                               c::headerGetEntry($header, 'release')));
  474.                      $cumulSize += c::headerGetEntry($header, 'size'); 
  475.                      my @files = c::headerGetEntry($header, 'filenames');
  476.                      @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| &&
  477.                                        ! -d "$prefix/$_" && ! -l "$prefix/$_") } @files} = ();
  478.                  });
  479.         eval { getHeader($p) };
  480.         my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
  481.         map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| } @availFiles;
  482.  
  483.         
  484.         
  485.         $p->{installedCumulSize} = $cumulSize;
  486.     }
  487.     }
  488.  
  489.     
  490.     
  491.     foreach (values %$packages) {
  492.     my $p = $_;
  493.  
  494.     if ($p->{selected}) {
  495.         eval { getHeader($p) };
  496.         my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
  497.         map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m|^/etc/rc.d/| } @availFiles;
  498.     }
  499.     }
  500.  
  501.     
  502.     foreach (values %$packages) {
  503.     my $p = $_;
  504.  
  505.     unless ($p->{selected}) {
  506.         eval { getHeader($p) };
  507.         my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
  508.         my $toSelect = 0;
  509.         map { if (exists $installedFilesForUpgrade{$_}) {
  510.         $toSelect ||= ! -d "$prefix/$_" && ! -l "$prefix/$_"; delete $installedFilesForUpgrade{$_} }
  511.           } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
  512.         pkgs::select($packages, $p) if ($toSelect);
  513.     }
  514.     }
  515.  
  516.     
  517.     
  518.     foreach (values %$packages) {
  519.     my $p = $_;
  520.  
  521.     eval { getHeader($p) };
  522.     my @obsoletes = $p->{header} ? c::headerGetEntry(getHeader($p), 'obsoletes'): ();
  523.     map { pkgs::select($packages, $p) if c::rpmdbNameTraverse($db, $_) > 0 } @obsoletes;
  524.     }
  525.  
  526.     
  527.     foreach (@$base) {
  528.     my $p = $packages->{$_} or log::l("missing base package $_"), next;
  529.     log::l("base package $_ is not installed") unless $p->{installed} || $p->{selected}; 
  530.     pkgs::select($packages, $p, 1) unless $p->{selected}; 
  531.     }
  532.  
  533.     
  534.     delete $toRemove{''};
  535.  
  536.     
  537.     
  538.     
  539.     
  540.     if ($toSave && keys %toRemove) {
  541.     c::rpmdbTraverse($db, sub {
  542.                  my ($header) = @_;
  543.                  my $otherPackage = (c::headerGetEntry($header, 'name'). '-' .
  544.                          c::headerGetEntry($header, 'version'). '-' .
  545.                          c::headerGetEntry($header, 'release'));
  546.                  if ($toRemove{$otherPackage}) {
  547.                  if ($packages->{c::headerGetEntry($header, 'name')}{base}) {
  548.                      delete $toRemove{$otherPackage}; 
  549.                  } else {
  550.                      my @files = c::headerGetEntry($header, 'filenames');
  551.                      my @flags = c::headerGetEntry($header, 'fileflags');
  552.                      for my $i (0..$#flags) {
  553.                      if ($flags[$i] & c::RPMFILE_CONFIG()) {
  554.                          push @$toSave, $files[$i] unless $files[$i] =~ /kdelnk/; 
  555.                      }
  556.                      }
  557.                  }
  558.                  }
  559.              });
  560.     }
  561.  
  562.     log::l("before closing db");
  563.     
  564.     c::rpmdbClose($db);
  565.     log::l("done selecting packages to upgrade");
  566.  
  567.     
  568.     @{$toRemove || []} = keys %toRemove;
  569. }
  570.  
  571. sub installCallback {
  572.     my $msg = shift;
  573.  
  574.     log::l($msg .": ". join(',', @_));
  575. }
  576.  
  577. sub install($$$;$) {
  578.     my ($prefix, $isUpgrade, $toInstall) = @_;
  579.     my %packages;
  580.  
  581.  
  582.  
  583.  
  584.  
  585.     return if $::g_auto_install;
  586.  
  587.     log::l("reading /usr/lib/rpm/rpmrc");
  588.     c::rpmReadConfigFiles() or die "can't read rpm config files";
  589.     log::l("\tdone");
  590.  
  591.     my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
  592.     log::l("opened rpm database for installing new packages");
  593.  
  594.     my $trans = c::rpmtransCreateSet($db, $prefix);
  595.  
  596.     my ($total, $nb);
  597.  
  598.     foreach my $p (@$toInstall) {
  599.     eval { getHeader($p) }; $@ and next;
  600.     $p->{file} ||= sprintf "%s-%s-%s.%s.rpm",
  601.                            $p->{name}, $p->{version}, $p->{release},
  602.                    c::headerGetEntry(getHeader($p), 'arch');
  603.     $packages{$p->{name}} = $p;
  604.     c::rpmtransAddPackage($trans, getHeader($p), $p->{name}, $isUpgrade && $p->{name} !~ /kernel/); 
  605.     $nb++;
  606.     $total += $p->{size};
  607.     }
  608.  
  609.     c::rpmdepOrder($trans) or
  610.     cdie "error ordering package list: " . c::rpmErrorString(),
  611.       sub {
  612.           c::rpmtransFree($trans);
  613.           c::rpmdbClose($db);
  614.       };
  615.     c::rpmtransSetScriptFd($trans, fileno LOG);
  616.  
  617.     eval { fs::mount("/proc", "$prefix/proc", "proc", 0) } unless -e "$prefix/proc/cpuinfo";
  618.  
  619.     my $callbackOpen = sub {
  620.     my $f = (my $p = $packages{$_[0]})->{file};
  621.     print LOG "$f\n";
  622.     my $fd = install_any::getFile($f) or log::l("ERROR: bad file $f");
  623.     $fd ? fileno $fd : -1;
  624.     };
  625.     my $callbackClose = sub { $packages{$_[0]}{installed} = 1; };
  626.     my $callbackMessage = \&pkgs::installCallback;
  627.  
  628.     
  629.     
  630.     
  631.     &$callbackMessage("Starting installation", $nb, $total);
  632.  
  633.     if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, $callbackMessage, 0)) {
  634.     my %parts;
  635.     @probs = reverse grep {
  636.         if (s/(installing package) .* (needs (?:.*) on the (.*) filesystem)/$1 $2/) {
  637.         $parts{$3} ? 0 : ($parts{$3} = 1);
  638.         } else { 1; }
  639.     } reverse @probs;
  640.  
  641.     c::rpmtransFree($trans);
  642.     c::rpmdbClose($db);
  643. #    if ($isUpgrade && !$useOnlyUpgrade && %parts) {
  644. #        
  645. #        log::l("trying to upgrade all packages to save space");
  646. #        install($prefix,$isUpgrade,$toInstall,1);
  647. #    }
  648.     die "installation of rpms failed:\n  ", join("\n  ", @probs);
  649.     }
  650.     c::rpmtransFree($trans);
  651.     c::rpmdbClose($db);
  652.     log::l("rpm database closed");
  653.  
  654.     install_any::rewindGetFile(); 
  655. }
  656.  
  657. sub remove($$) {
  658.     my ($prefix, $toRemove) = @_;
  659.  
  660.     return if $::g_auto_install || !@{$toRemove || []};
  661.  
  662.     log::l("reading /usr/lib/rpm/rpmrc");
  663.     c::rpmReadConfigFiles() or die "can't read rpm config files";
  664.     log::l("\tdone");
  665.  
  666.     my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
  667.     log::l("opened rpm database for removing old packages");
  668.  
  669.     my $trans = c::rpmtransCreateSet($db, $prefix);
  670.  
  671.     foreach my $p (@$toRemove) {
  672.     
  673.     c::rpmtransRemovePackages($db, $trans, $p) if $p !~ /kernel/;
  674.     }
  675.  
  676.     eval { fs::mount("/proc", "$prefix/proc", "proc", 0) } unless -e "$prefix/proc/cpuinfo";
  677.  
  678.     my $callbackOpen = sub { log::l("trying to open file from $_[0] which should not happen"); };
  679.     my $callbackClose = sub { log::l("trying to close file from $_[0] which should not happen"); };
  680.     my $callbackMessage = \&pkgs::installCallback;
  681.  
  682.     
  683.     
  684.  
  685.     
  686.     
  687.     
  688.     &$callbackMessage("Starting removing other packages", scalar @$toRemove);
  689.  
  690.     if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, $callbackMessage, 0)) {
  691.     die "removing of old rpms failed:\n  ", join("\n  ", @probs);
  692.     }
  693.     c::rpmtransFree($trans);
  694.     c::rpmdbClose($db);
  695.     log::l("rpm database closed");
  696.  
  697.     
  698.     @{$toRemove || []} = ();
  699. }
  700.  
  701. 1;
  702.